Void.pm 8.82 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
14
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;

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

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

21
22
with 'Ravada::VM';

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

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

36
37
38
##########################################################################
#

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

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

50
51
52
    warn "ERROR: error connecting to ".$self->host." $err"  if $err;
    return 0 if $err;
    return 1;
53
54
}

55
sub connect($self) {
56
57
    return 1 if $self->vm;
    return $self->vm($self->_connect);
58
59
}

60
61
62
sub disconnect {
    my $self = shift;
    $self->vm(0);
63
64
65
66

    return if !$self->{_ssh};
    $self->{_ssh}->disconnect;
    delete $self->{_ssh};
67
68
}

69
sub reconnect {}
70
71

sub create_domain {
72
73
74
75
    my $self = shift;
    my %args = @_;

    croak "argument name required"       if !$args{name};
Francesc Guasch's avatar
Francesc Guasch committed
76
77
78
    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";
79

Francesc Guasch's avatar
Francesc Guasch committed
80
81
    my $volatile = delete $args{volatile};
    my $active = ( delete $args{active} or $volatile or $user->is_temporary or 0);
82
83
    my $listen_ip = delete $args{listen_ip};
    confess if $args{name} eq 'tst_vm_v20_volatile_clones_02' && !$listen_ip;
84
85
86
    my $domain = Ravada::Domain::Void->new(
                                           %args
                                           , domain => $args{name}
87
                                           , _vm => $self
88
    );
Francesc Guasch's avatar
Francesc Guasch committed
89
90
91
92
    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;
93
    $domain->_set_default_info($listen_ip);
Francesc Guasch's avatar
Francesc Guasch committed
94
95
96
    $domain->_store( autostart => 0 );
    $domain->_store( is_active => $active );
    $domain->set_memory($args{memory}) if $args{memory};
97

Francesc Guasch's avatar
Francesc Guasch committed
98
    $domain->_insert_db(name => $args{name} , id_owner => $user->id
Francesc Guasch's avatar
Francesc Guasch committed
99
        , id_vm => $self->id
100
        , id_base => $args{id_base} );
101

102
    if ($args{id_base}) {
Francesc Guasch's avatar
Francesc Guasch committed
103
        my $owner = $user;
104
105
106
107
        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;

108
109
110
111
112
113
114
115
116
117
        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
                                , file => $vol_clone->file
118
                                 ,type => 'file');
119
        }
Francesc Guasch's avatar
Francesc Guasch committed
120
121
122
        my $drivers = {};
        $drivers = $domain_base->_value('drivers');
        $domain->_store( drivers => $drivers );
123
124
    } else {
        my ($file_img) = $domain->disk_device();
125
        my ($vda_name) = "$args{name}-vda-".Ravada::Utils::random_name(4).".void";
Francesc Guasch's avatar
Francesc Guasch committed
126
127
        $file_img =~ m{.*/(.*)} if $file_img;
        $domain->add_volume(name => $vda_name
Francesc Guasch's avatar
Francesc Guasch committed
128
129
                        , capacity => ( $args{disk} or 1024)
                        , file => $file_img
130
131
                        , type => 'file'
                        , target => 'vda'
132
        );
Francesc Guasch's avatar
Francesc Guasch committed
133
134
135
136
137
        my $cdrom_file = $domain->_config_dir()."/$args{name}-cdrom-"
            .Ravada::Utils::random_name(4).".iso";
        my ($cdrom_name) = $cdrom_file =~ m{.*/(.*)};
        $domain->add_volume(name => $cdrom_name
                        , file => $cdrom_file
Francesc Guasch's avatar
Francesc Guasch committed
138
                        , device => 'cdrom'
Francesc Guasch's avatar
Francesc Guasch committed
139
                        , type => 'cdrom'
Francesc Guasch's avatar
Francesc Guasch committed
140
141
                        , target => 'hdc'
        );
142
        $domain->_set_default_drivers();
143
        $domain->_set_default_info($listen_ip);
Francesc Guasch's avatar
Francesc Guasch committed
144
        $domain->_store( is_active => 0 );
145

Francesc Guasch's avatar
Francesc Guasch committed
146
147
        $domain->_store( is_active => 1 ) if $volatile || $user->is_temporary;

148
    }
149
    $domain->set_memory($args{memory}) if $args{memory};
150
#    $domain->start();
151
    return $domain;
152
153
154
155
156
}

sub create_volume {
}

Francesc Guasch's avatar
Francesc Guasch committed
157
sub dir_img {
158
    return Ravada::Front::Domain::Void::_config_dir();
Francesc Guasch's avatar
Francesc Guasch committed
159
160
}

161
162
163
sub dir_base  { return dir_img }
sub dir_clone { return dir_img }

164
165
166
167
168
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
169

170
    opendir my $ls,dir_img or return;
171

Francesc Guasch's avatar
Francesc Guasch committed
172
    my @domain;
173
    while (my $file = readdir $ls ) {
174
        my $domain = $self->_is_a_domain($file) or next;
175
        next if defined $active && $active && !$domain->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
176
        push @domain , ($domain);
177
178
179
180
    }

    closedir $ls;

Francesc Guasch's avatar
Francesc Guasch committed
181
    return @domain;
182
183
}

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
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;
}

201
202
203
204
205
sub _list_domains_remote($self, %args) {

    my $active = delete $args{active};

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

207
    my ($out, $err) = $self->run_command("ls -1 ".$self->dir_img);
208
209

    my @domain;
210
    for my $file (split /\n/,$out) {
Francesc Guasch's avatar
Francesc Guasch committed
211
212
        if ( my $domain = $self->_is_a_domain($file)) {
            next if defined $active && $active
213
                        && !$domain->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
214
            push @domain,($domain);
215
216
        }
    }
217

218
219
220
    return @domain;
}

221
sub list_domains($self, %args) {
Francesc Guasch's avatar
Francesc Guasch committed
222
    return $self->_list_domains_local(%args) if $self->is_local();
223
    return $self->_list_domains_remote(%args);
224
225
}

226
sub search_domain {
227
    my $self = shift;
228
    my $name = shift or confess "ERROR: Missing name";
229

230
231
    for my $domain_vm ( $self->list_domains ) {
        next if $domain_vm->name ne $name;
232

Francesc Guasch's avatar
Francesc Guasch committed
233
234
235
        my $domain = Ravada::Domain::Void->new( 
            domain => $name
            ,readonly => $self->readonly
236
                 ,_vm => $self
Francesc Guasch's avatar
Francesc Guasch committed
237
        );
238
        my $id;
239

240
        eval { $id = $domain->id };
241
        warn $@ if $@;
242
        return if !defined $id;#
Francesc Guasch's avatar
Francesc Guasch committed
243
        $domain->_insert_db_extra   if !$domain->is_known_extra();
244
245
        return $domain;
    }
246
    return;
247
248
}

249
250
251
252
sub list_networks {
    return Ravada::NetInterface::Void->new();
}

Francesc Guasch's avatar
Francesc Guasch committed
253
254
255
sub search_volume($self, $pattern) {

    return $self->_search_volume_remote($pattern)   if !$self->is_local;
Francesc Guasch's avatar
Francesc Guasch committed
256
257
258
259
260
261
262
263
264

    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
265
266
sub _search_volume_remote($self, $pattern) {

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

    my $found;
270
    for my $file ( split /\n/,$out ) {
Francesc Guasch's avatar
Francesc Guasch committed
271
        $found = $self->dir_img."/".$file if $file eq $pattern;
Francesc Guasch's avatar
Francesc Guasch committed
272
273
274
275
276
    }

    return $found;
}

Francesc Guasch's avatar
Francesc Guasch committed
277
278
279
280
281
282
283
284
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
285
    die "TODO remote" if !$self->is_local;
Francesc Guasch's avatar
Francesc Guasch committed
286

Francesc Guasch's avatar
Francesc Guasch committed
287
288
289
290
291
292
293
294
295
    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;

}

296
297
298
299
300
301
302
303
304
305
306
307
sub import_domain($self, $name, $user) {

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

308
309
}

310
311
sub refresh_storage {}

312
313
314
sub refresh_storage_pools {

}
Francesc Guasch's avatar
Francesc Guasch committed
315
316

sub list_storage_pools {
317
    return 'default';
Francesc Guasch's avatar
Francesc Guasch committed
318
}
319
320
321
322
323

sub is_alive($self) {
    return 0 if !$self->vm;
    return 1;
}
324

Francesc Guasch's avatar
Francesc Guasch committed
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
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
341
342
343
sub _fetch_dir_cert {
    confess "TODO";
}
Francesc Guasch's avatar
Francesc Guasch committed
344
345
346
347
348
349
350
351
352

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";
}
353
354
355
#########################################################################3

1;