Ravada.pm 6.46 KB
Newer Older
1
2
3
4
5
package Ravada;

use warnings;
use strict;

6
use Data::Dumper;
7
8
9
10
use DBIx::Connector;
use Moose;
use YAML;

11
use Ravada::Request;
12
13
use Ravada::VM::KVM;

Francesc Guasch's avatar
Francesc Guasch committed
14
15
16
17
18
19
20
21
22
23
24
25
=head1 NAME

Ravada - Remove Virtual Desktop Manager

=head1 SYNOPSIS

  use Ravada;

  my $ravada = Ravada->new()

=cut

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

our $FILE_CONFIG = "/etc/ravada.conf";

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

our $CONNECTOR;
our $CONFIG = {};
_connect_dbh();


has 'vm' => (
          is => 'ro'
        ,isa => 'ArrayRef'
       ,lazy => 1
     , builder => '_create_vm'
);

has 'connector' => (
44
45
46
47
48
49
        is => 'rw'
);

has 'config' => (
    is => 'ro'
    ,isa => 'Str'
50
51
);

Francesc Guasch's avatar
Francesc Guasch committed
52
53
54
55
56
57
58
=head2 BUILD

Internal constructor

=cut


59
60
sub BUILD {
    my $self = shift;
61
    if ($self->config()) {
62
        _init_config($self->config);
63
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
64
        _init_config($FILE_CONFIG) if -e $FILE_CONFIG;
65
    }
66

Francesc Guasch's avatar
Francesc Guasch committed
67
68
69
70
    if ( $self->connector ) {
        $CONNECTOR = $self->connector 
    } else {
        $CONNECTOR = $self->_connect_dbh();
71
        $self->connector($CONNECTOR);
Francesc Guasch's avatar
Francesc Guasch committed
72
    }
73

74
75
76
77
78
79
}

sub _connect_dbh {
    my $driver= ($CONFIG->{db}->{driver} or 'mysql');;
    my $db_user = ($CONFIG->{db}->{user} or getpwnam($>));;
    my $db_pass = ($CONFIG->{db}->{password} or undef);
Francesc Guasch's avatar
Francesc Guasch committed
80
81
    my $db = ( $CONFIG->{db}->{db} or 'ravada' );
    return DBIx::Connector->new("DBI:$driver:$db"
82
83
84
85
86
87
88
89
90
91
92
93
94
                        ,$db_user,$db_pass,{RaiseError => 1
                        , PrintError=> 0 });

}

sub _init_config {
    my $file = shift;
    $CONFIG = YAML::LoadFile($file);
    _connect_dbh();
}

sub _create_vm {
    my $self = shift;
95
    return [ Ravada::VM::KVM->new( connector => ( $self->connector or $CONNECTOR )) ];
96
97
}

Francesc Guasch's avatar
Francesc Guasch committed
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
=head2 create_domain

Creates a new domain based on an ISO image or another domain.

  my $domain = $ravada->create_domain( 
         name => $name
    , id_iso => 1
  );


  my $domain = $ravada->create_domain( 
         name => $name
    , id_base => 3
  );


=cut


117
sub create_domain {
118
119
    my $self = shift;

120
121
122
    return $self->vm->[0]->create_domain(@_);
}

Francesc Guasch's avatar
Francesc Guasch committed
123
124
125
126
127
128
129
130
=head2 remove_domain

Removes a domain

  $ravada->remove_domain($name);

=cut

131
132
133
134
135
136
137
138
139
sub remove_domain {
    my $self = shift;
    my $name = shift or confess "Missing domain name";

    my $domain = $self->search_domain($name)
        or confess "ERROR: I can't find domain $name";
    $domain->remove();
}

Francesc Guasch's avatar
Francesc Guasch committed
140
141
142
143
144
145
=head2 search_domain

  my $domain = $ravada->search_domain($name);

=cut

146
147
148
149
150
151
152
153
sub search_domain {
    my $self = shift;
    my $name = shift;

    for my $vm (@{$self->vm}) {
        my $domain = $vm->search_domain($name);
        return $domain if $domain;
    }
154
}
155

Francesc Guasch's avatar
Francesc Guasch committed
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
=head2 search_domain_by_id

  my $domain = $ravada->search_domain_by_id($id);

=cut

sub search_domain_by_id {
    my $self = shift;
      my $id = shift;

    for my $vm (@{$self->vm}) {
        my $domain = $vm->search_domain_by_id($id);
        return $domain if $domain;
    }
}


173
174
=head2 list_domains

Francesc Guasch's avatar
Francesc Guasch committed
175
List all created domains
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191

  my @list = $ravada->list_domains();

=cut

sub list_domains {
    my $self = shift;
    my @domains;
    for my $vm (@{$self->vm}) {
        for my $domain ($vm->list_domains) {
            push @domains,($domain);
        }
    }
    return @domains;
}

Francesc Guasch's avatar
Francesc Guasch committed
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
=head2 list_bases

List all base domains

  my @list = $ravada->list_domains();


=cut

sub list_bases {
    my $self = shift;
    my @domains;
    for my $vm (@{$self->vm}) {
        for my $domain ($vm->list_domains) {
            push @domains,($domain) if $domain->is_base;
        }
    }
    return @domains;
}

Francesc Guasch's avatar
Francesc Guasch committed
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
=head2 list_images

List all ISO images

=cut

sub list_images {
    my $self = shift;
    my @domains;
    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT * FROM iso_images ORDER BY name"
    );
    $sth->execute;
    while (my $row = $sth->fetchrow_hashref) {
        push @domains,($row);
    }
    $sth->finish;
    return @domains;
}

Francesc Guasch's avatar
Francesc Guasch committed
232

Francesc Guasch's avatar
Francesc Guasch committed
233
234
235
236
=head2 remove_volume

  $ravada->remove_volume($file);

Francesc Guasch's avatar
Francesc Guasch committed
237

Francesc Guasch's avatar
Francesc Guasch committed
238
239
=cut

240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
sub remove_volume {
    my $self = shift;

    my $file = shift;
    my ($name) = $file =~ m{.*/(.*)};

    my $removed = 0;
    for my $vm (@{$self->vm}) {
        my $vol = $vm->search_volume($name);
        next if !$vol;

        $vol->delete();
        $removed++;
    }
    if (!$removed && -e $file ) {
        warn "volume $file not found. removing file $file.\n";
        unlink $file or die "$! $file";
    }

}
260

Francesc Guasch's avatar
Francesc Guasch committed
261
262
263
264
265
266
267
268
=head2 process_requests

This is run in the ravada backend. It processes the commands requested by the fronted

  $ravada->process_requests();

=cut

269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
sub process_requests {
    my $self = shift;

    my $sth = $CONNECTOR->dbh->prepare("SELECT id FROM requests WHERE status='requested'");
    $sth->execute;
    while (my ($id)= $sth->fetchrow) {
        $self->_execute(Ravada::Request->open($id));
    }
    $sth->finish;
}

sub _execute {
    my $self = shift;
    my $request = shift;

Francesc Guasch's avatar
Francesc Guasch committed
284
285
286
287
288
289
290
291
292
293
294
295
296
    my $sub = $self->_req_method($request->command);

    die "Unknown command ".$request->command
        if !$sub;

    return $sub->($self,$request);

}

sub _cmd_create {
    my $self = shift;
    my $request = shift;

297
298
299
300
301
302
303
304
    $request->status('creating domain');
    my $domain;
    eval {$domain = $self->create_domain(%{$request->args}) };

    if ($request->args('is_base') ) {
        $request->status('preparing base');
        $domain->prepare_base();
    }
Francesc Guasch's avatar
Francesc Guasch committed
305
306
307
308
309
310
311
312
313
314
315
316
317
    $request->status('done');
    $request->error($@);

}

sub _cmd_remove {
    my $self = shift;
    my $request = shift;

    $request->status('working');
    eval { $self->remove_domain($request->args('name')) };
    $request->status('done');
    $request->error($@);
Francesc Guasch's avatar
Francesc Guasch committed
318

319
}
Francesc Guasch's avatar
Francesc Guasch committed
320

Francesc Guasch's avatar
Francesc Guasch committed
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
sub _cmd_start {
    my $self = shift;
    my $request = shift;

    $request->status('working');
    my $name = $request->args('name');
    eval { 
        my $domain = $self->search_domain($name);
        die "Unknown domain '$name'\n" if !$domain;
        $domain->start();
    };
    $request->status('done');
    $request->error($@);

}

Francesc Guasch's avatar
Francesc Guasch committed
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
sub _cmd_shutdown {
    my $self = shift;
    my $request = shift;

    $request->status('working');
    my $name = $request->args('name');
    eval { 
        my $domain = $self->search_domain($name);
        die "Unknown domain '$name'\n" if !$domain;
        $domain->shutdown();
    };
    $request->status('done');
    $request->error($@);

}


Francesc Guasch's avatar
Francesc Guasch committed
354
355
356
357
358
sub _req_method {
    my $self = shift;
    my  $cmd = shift;

    my %methods = (
Francesc Guasch's avatar
Francesc Guasch committed
359

Francesc Guasch's avatar
Francesc Guasch committed
360
361
362
          start => \&_cmd_start
        ,create => \&_cmd_create
        ,remove => \&_cmd_remove
Francesc Guasch's avatar
Francesc Guasch committed
363
      ,shutdown => \&_cmd_shutdown
Francesc Guasch's avatar
Francesc Guasch committed
364
365
366
367
368
    );
    return $methods{$cmd};
}


Francesc Guasch's avatar
Francesc Guasch committed
369
370
371
372
373
374
375
376
377
378
=head1 AUTHOR

Francesc Guasch-Ortiz	, frankie@telecos.upc.edu

=head1 SEE ALSO

Sys::Virt

=cut

379
1;