Void.pm 11.8 KB
Newer Older
1
2
package Ravada::VM::Void;

Francesc Guasch's avatar
Francesc Guasch committed
3
use Carp qw(carp croak);
4
5
6
7
8
9
10
11
12
13
use Data::Dumper;
use Encode;
use Encode::Locale;
use Fcntl qw(:flock O_WRONLY O_EXCL O_CREAT);
use Hash::Util qw(lock_hash);
use IPC::Run3 qw(run3);
use Moose;
use Socket qw( inet_aton inet_ntoa );
use Sys::Hostname;
use URI;
14
use YAML qw(Dump);
15

16
use Ravada::Domain::Void;
17
18
use Ravada::NetInterface::Void;

19
20
21
no warnings "experimental::signatures";
use feature qw(signatures);

22
23
with 'Ravada::VM';

Francesc Guasch's avatar
Francesc Guasch committed
24
25
26
has 'type' => (
    is => 'ro'
    ,isa => 'Str'
27
    ,default => 'Void'
Francesc Guasch's avatar
Francesc Guasch committed
28
29
);

30
has 'vm' => (
31
    is => 'rw'
32
    ,isa => 'Any'
33
    ,builder => '_connect'
Francesc Guasch's avatar
Francesc Guasch committed
34
    ,lazy => 1
35
36
);

37
38
our $CONNECTOR = \$Ravada::CONNECTOR;

39
40
41
##########################################################################
#

42
sub _connect {
43
    my $self = shift;
44
    return 1 if ! $self->host || $self->host eq 'localhost'
45
46
                || $self->host eq '127.0.0.1'
                || $self->{_ssh};
47

48
49
50
51
    my ($out, $err);
    eval {
       ($out, $err)= $self->run_command("ls -l ".$self->dir_img." || mkdir -p ".$self->dir_img);
    };
52

53
54
55
    warn "ERROR: error connecting to ".$self->host." $err"  if $err;
    return 0 if $err;
    return 1;
56
57
}

58
sub connect($self) {
59
60
    return 1 if $self->vm;
    return $self->vm($self->_connect);
61
62
}

63
64
65
sub disconnect {
    my $self = shift;
    $self->vm(0);
66
67
68
69

    return if !$self->{_ssh};
    $self->{_ssh}->disconnect;
    delete $self->{_ssh};
70
71
}

72
sub reconnect {}
73
74

sub create_domain {
75
76
77
78
    my $self = shift;
    my %args = @_;

    croak "argument name required"       if !$args{name};
Francesc Guasch's avatar
Francesc Guasch committed
79
80
81
    my $id_owner = delete $args{id_owner} or confess "ERROR: The id_owner is mandatory";
    my $user = Ravada::Auth::SQL->search_by_id($id_owner)
        or confess "ERROR: User id $id_owner doesn't exist";
82

Francesc Guasch's avatar
Francesc Guasch committed
83
84
    my $volatile = delete $args{volatile};
    my $active = ( delete $args{active} or $volatile or $user->is_temporary or 0);
85
    my $listen_ip = delete $args{listen_ip};
86
    my $description = delete $args{description};
87
    confess if $args{name} eq 'tst_vm_v20_volatile_clones_02' && !$listen_ip;
Francesc Guasch's avatar
Francesc Guasch committed
88
    my $remote_ip = delete $args{remote_ip};
89
90
91
    my $domain = Ravada::Domain::Void->new(
                                           %args
                                           , domain => $args{name}
92
                                           , _vm => $self
93
    );
Francesc Guasch's avatar
Francesc Guasch committed
94
95
96
97
    my ($out, $err) = $self->run_command("/usr/bin/test",
         "-e ".$domain->_config_file." && echo 1" );
    chomp $out;
    die "Error: Domain $args{name} already exists " if $out;
98
    $domain->_set_default_info($listen_ip);
Francesc Guasch's avatar
Francesc Guasch committed
99
100
101
    $domain->_store( autostart => 0 );
    $domain->_store( is_active => $active );
    $domain->set_memory($args{memory}) if $args{memory};
102

Francesc Guasch's avatar
Francesc Guasch committed
103
    $domain->_insert_db(name => $args{name} , id_owner => $user->id
Francesc Guasch's avatar
Francesc Guasch committed
104
        , id_vm => $self->id
105
106
107
        , id_base => $args{id_base} 
        , description => $description
    );
108

109
    if ($args{id_base}) {
Francesc Guasch's avatar
Francesc Guasch committed
110
        my $owner = $user;
111
112
113
114
        my $domain_base = $self->search_domain_by_id($args{id_base});

        confess "I can't find base domain id=$args{id_base}" if !$domain_base;

115
116
117
118
119
120
121
122
123
        for my $base_t ($domain_base->list_files_base_target) {
            my ($file_base, $target ) = @$base_t;
            my $vol_base = Ravada::Volume->new(
                file => $file_base
                ,is_base => 1
                ,vm => $domain_base->_vm
            );
            my $vol_clone = $vol_base->clone(name => "$args{name}-$target");
            $domain->add_volume(name => $vol_clone->name
124
                              , target => $target
125
                                , file => $vol_clone->file
126
127
                                 ,type => 'file'
                             );
128
        }
Francesc Guasch's avatar
Francesc Guasch committed
129
130
131
132
133
134
135
136
137
138
139
140
141
        my $base_hw = $domain_base->_value('hardware');
        my $clone_hw = $domain->_value('hardware');
        for my $hardware( keys %{$base_hw} ) {
            next if $hardware eq 'device';
            $clone_hw->{$hardware} = $base_hw->{$hardware};
            next if $hardware ne 'display';
            for my $entry ( @{$clone_hw->{$hardware}} ) {
                $entry->{port} = 'auto' if $entry->{port};
                $entry->{port} = $domain->_new_free_port() if $active || $volatile;
                $entry->{ip} = $listen_ip;
            }
        }
        $domain->_store(hardware => $clone_hw);
Francesc Guasch's avatar
Francesc Guasch committed
142
143
144
        my $drivers = {};
        $drivers = $domain_base->_value('drivers');
        $domain->_store( drivers => $drivers );
145
146
    } else {
        my ($file_img) = $domain->disk_device();
147
        my ($vda_name) = "$args{name}-vda-".Ravada::Utils::random_name(4).".void";
Francesc Guasch's avatar
Francesc Guasch committed
148
149
        $file_img =~ m{.*/(.*)} if $file_img;
        $domain->add_volume(name => $vda_name
Francesc Guasch's avatar
Francesc Guasch committed
150
151
                        , capacity => ( $args{disk} or 1024)
                        , file => $file_img
152
153
                        , type => 'file'
                        , target => 'vda'
154
        );
155
156

        $self->_add_cdrom($domain, %args);
157
        $domain->_set_default_drivers();
158
        $domain->_set_default_info($listen_ip);
Francesc Guasch's avatar
Francesc Guasch committed
159
        $domain->_store( is_active => $active );
Francesc Guasch's avatar
Francesc Guasch committed
160

161
    }
162
    $domain->set_memory($args{memory}) if $args{memory};
Francesc Guasch's avatar
Francesc Guasch committed
163
164
165
    if ( $volatile || $user->is_temporary ) {
        $domain->_store( is_active => 1 );
    }
166
#    $domain->start();
167
    return $domain;
168
169
}

170
171
172
173
174
175
176
177
178
sub _add_cdrom($self, $domain, %args) {
    my $id_iso = delete $args{id_iso};
    my $iso_file = delete $args{iso_file};
    return if !$id_iso && !$iso_file;

    if ($id_iso && ! $iso_file) {
        my $sth = $$CONNECTOR->dbh->prepare("SELECT * FROM iso_images WHERE id=?");
        $sth->execute($id_iso);
        my $row = $sth->fetchrow_hashref();
179
        return if !$row->{has_cd};
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
        $iso_file = $row->{device};
        if (!$iso_file) {
            $iso_file = $row->{name};
            $iso_file =~ s/\s/_/g;
            $iso_file=$self->dir_img."/".lc($iso_file).".iso";
            if (! -e $iso_file ) {
                $self->write_file($iso_file,Dump({iso => "ISO mock $row->{name}"}));
            }
        }
    }
    $iso_file = '' if $iso_file eq '<NONE>';
    $domain->add_volume(
        file => $iso_file
        , device => 'cdrom'
        , type => 'cdrom'
        , target => 'hdc'
    );
}

199
200
201
sub create_volume {
}

Francesc Guasch's avatar
Francesc Guasch committed
202
sub dir_img {
203
    return Ravada::Front::Domain::Void::_config_dir();
Francesc Guasch's avatar
Francesc Guasch committed
204
205
}

206
207
208
sub dir_base  { return dir_img }
sub dir_clone { return dir_img }

209
210
211
212
213
sub _storage_path($self, $storage) {
    confess "Error: unknown storage '$storage'" if $storage ne 'default';
    return dir_img;
}

214
215
216
217
218
sub _list_domains_local($self, %args) {
    my $active = delete $args{active};

    confess "Wrong arguments ".Dumper(\%args)
        if keys %args;
Francesc Guasch's avatar
Francesc Guasch committed
219

220
    opendir my $ls,dir_img or return;
221

Francesc Guasch's avatar
Francesc Guasch committed
222
    my @domain;
223
    while (my $file = readdir $ls ) {
224
        my $domain = $self->_is_a_domain($file) or next;
225
        next if defined $active && $active && !$domain->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
226
        push @domain , ($domain);
227
228
229
230
    }

    closedir $ls;

Francesc Guasch's avatar
Francesc Guasch committed
231
    return @domain;
232
233
}

234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
sub _is_a_domain($self, $file) {

    chomp $file;

    return if $file !~ /\.yml$/;
    $file =~ s/\.\w+//;
    $file =~ s/(.*)\.qcow.*$/$1/;
    return if $file !~ /\w/;

    my $domain = Ravada::Domain::Void->new(
                    domain => $file
                     , _vm => $self
    );
    return if !$domain->is_known;
    return $domain;
}

251
252
253
254
255
sub _list_domains_remote($self, %args) {

    my $active = delete $args{active};

    confess "Wrong arguments ".Dumper(\%args) if keys %args;
256

257
    my ($out, $err) = $self->run_command("ls -1 ".$self->dir_img);
258
259

    my @domain;
260
    for my $file (split /\n/,$out) {
Francesc Guasch's avatar
Francesc Guasch committed
261
262
        if ( my $domain = $self->_is_a_domain($file)) {
            next if defined $active && $active
263
                        && !$domain->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
264
            push @domain,($domain);
265
266
        }
    }
267

268
269
270
    return @domain;
}

271
sub list_domains($self, %args) {
Francesc Guasch's avatar
Francesc Guasch committed
272
    return $self->_list_domains_local(%args) if $self->is_local();
273
    return $self->_list_domains_remote(%args);
274
275
}

276
sub search_domain {
277
    my $self = shift;
278
    my $name = shift or confess "ERROR: Missing name";
279

280
281
    for my $domain_vm ( $self->list_domains ) {
        next if $domain_vm->name ne $name;
282

Francesc Guasch's avatar
Francesc Guasch committed
283
284
285
        my $domain = Ravada::Domain::Void->new( 
            domain => $name
            ,readonly => $self->readonly
286
                 ,_vm => $self
Francesc Guasch's avatar
Francesc Guasch committed
287
        );
288
        my $id;
289

290
        eval { $id = $domain->id };
291
        warn $@ if $@;
292
        return if !defined $id;#
Francesc Guasch's avatar
Francesc Guasch committed
293
        $domain->_insert_db_extra   if !$domain->is_known_extra();
294
295
        return $domain;
    }
296
    return;
297
298
}

299
300
301
302
sub list_networks {
    return Ravada::NetInterface::Void->new();
}

Francesc Guasch's avatar
Francesc Guasch committed
303
304
305
sub search_volume($self, $pattern) {

    return $self->_search_volume_remote($pattern)   if !$self->is_local;
Francesc Guasch's avatar
Francesc Guasch committed
306
307
308
309
310
311
312
313
314

    opendir my $ls,$self->dir_img or die $!;
    while (my $file = readdir $ls) {
        return $self->dir_img."/".$file if $file eq $pattern;
    }
    closedir $ls;
    return;
}

Francesc Guasch's avatar
Francesc Guasch committed
315
316
sub _search_volume_remote($self, $pattern) {

317
    my ($out, $err) = $self->run_command("ls -1 ".$self->dir_img);
Francesc Guasch's avatar
Francesc Guasch committed
318

319
320
    confess $err if $err;

Francesc Guasch's avatar
Francesc Guasch committed
321
    my $found;
322
    for my $file ( split /\n/,$out ) {
Francesc Guasch's avatar
Francesc Guasch committed
323
        $found = $self->dir_img."/".$file if $file eq $pattern;
Francesc Guasch's avatar
Francesc Guasch committed
324
325
326
327
328
    }

    return $found;
}

Francesc Guasch's avatar
Francesc Guasch committed
329
330
331
332
333
334
335
336
sub search_volume_path {
    return search_volume(@_);
}

sub search_volume_path_re {
    my $self = shift;
    my $pattern = shift;

Francesc Guasch's avatar
Francesc Guasch committed
337
    die "TODO remote" if !$self->is_local;
Francesc Guasch's avatar
Francesc Guasch committed
338

Francesc Guasch's avatar
Francesc Guasch committed
339
340
341
342
343
344
345
346
347
    opendir my $ls,$self->dir_img or die $!;
    while (my $file = readdir $ls) {
        return $self->dir_img."/".$file if $file =~ m{$pattern};
    }
    closedir $ls;
    return;

}

348
sub import_domain($self, $name, $user, $backing_file) {
349
350
351
352
353
354
355
356
357
358
359

    my $file = $self->dir_img."/$name.yml";

    die "Error: domain $name not found in ".$self->dir_img if !-e $file;

    return Ravada::Domain::Void->new(
        domain => $file
        ,name => $name
        ,_vm => $self
    );

360
361
}

362
363
sub refresh_storage {}

364
365
366
sub refresh_storage_pools {

}
Francesc Guasch's avatar
Francesc Guasch committed
367
368

sub list_storage_pools {
369
    return 'default';
Francesc Guasch's avatar
Francesc Guasch committed
370
}
371
372
373

sub is_alive($self) {
    return 0 if !$self->vm;
Francesc Guasch's avatar
Francesc Guasch committed
374
    return $self->ping(undef,0);
375
}
376

Francesc Guasch's avatar
Francesc Guasch committed
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
sub free_memory {
    my $self = shift;

    open my $mem,'<',"/proc/meminfo" or die "$! /proc/meminfo";
    my $memory = <$mem>;
    close $mem;

    chomp $memory;
    $memory =~ s/.*?(\d+).*/$1/;
    for my $domain ( $self->list_domains(active => 1) ) {
        next if !$domain->is_active;
        $memory -= $domain->get_info->{memory};
    }
    return $memory;
}

Francesc Guasch's avatar
Francesc Guasch committed
393
394
395
sub _fetch_dir_cert {
    confess "TODO";
}
Francesc Guasch's avatar
Francesc Guasch committed
396
397
398
399
400
401
402
403
404

sub free_disk($self, $storage_pool = undef) {
    my $df = `df`;
    for my $line (split /\n/, $df) {
        my @info = split /\s+/,$line;
        return $info[3] * 1024 if $info[5] eq '/';
    }
    die "Not found";
}
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425

=head2 file_exists

Returns true if the file exists in this virtual manager storage

=cut

sub file_exists( $self, $file ) {
    return -e $file if $self->is_local;

    my $ssh = $self->_ssh;
    confess "Error: no ssh connection to ".$self->name if ! $ssh;

    confess "Error: dangerous filename '$file'"
        if $file =~ /[`|"(\\\[]/;
    my ($out, $err) = $self->run_command("/bin/ls -1 $file");

    return 1 if !$err;
    return 0;
}

Francesc Guasch's avatar
Francesc Guasch committed
426
427
428
429
sub _is_ip_nat($self, $ip) {
    return 1;
}

430
431
432
433
434
435
436
437
438
439
440
sub _search_iso($self, $id, $device = undef) {
    my $sth = $$CONNECTOR->dbh->prepare("SELECT * FROM iso_images "
        ." WHERE id=?"
    );
    $sth->execute($id);
    my $row = $sth->fetchrow_hashref;
    $row->{device} = $device if defined $device;
    return $row;
}

sub _iso_name($self, $iso, $request=undef, $verbose=0) {
441
442
443

    return '' if !$iso->{has_cd};

444
445
446
447
    my $name = ($iso->{device} or $iso->{rename_file} or $iso->{file_re});
    confess Dumper($iso) if !$name;
    $name =~ s/(.*)\.\*(.*)/$1$2/;
    $name =~ s/(.*)\.\+(.*)/$1.$2/;
448
    $name =~ s/(.*)\[\\d.*?\]\+(.*)/${1}1$2/;
449
450
451
452
453
454
455
456
457
458
459
460
    confess $name if $name =~ m{[*+\\]};

    $name = $self->dir_img."/".$name unless $name =~ m{^/};

    my $sth = $$CONNECTOR->dbh->prepare(
        "UPDATE iso_images "
        ." SET device=? WHERE id=?"
    );
    $sth->execute($name, $iso->{id});
    return $name;
}

461
462
463
#########################################################################3

1;