Ravada.pm 4.7 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
44

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

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

our $CONNECTOR;
our $CONFIG = {};
_init_config($FILE_CONFIG) if -e $FILE_CONFIG;
_connect_dbh();


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

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

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

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

Internal constructor

=cut


60
61
sub BUILD {
    my $self = shift;
62
63
64
    if ($self->config ) {
        _init_config($self->config);
    }
Francesc Guasch's avatar
Francesc Guasch committed
65
66
67
68
    if ( $self->connector ) {
        $CONNECTOR = $self->connector 
    } else {
        $CONNECTOR = $self->_connect_dbh();
69
        $self->connector($CONNECTOR);
Francesc Guasch's avatar
Francesc Guasch committed
70
    }
71

72
73
74
75
76
77
}

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
78
79
    my $db = ( $CONFIG->{db}->{db} or 'ravada' );
    return DBIx::Connector->new("DBI:$driver:$db"
80
81
82
83
84
85
86
87
88
89
90
91
92
                        ,$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;
93
    return [ Ravada::VM::KVM->new( connector => ( $self->connector or $CONNECTOR )) ];
94
95
}

Francesc Guasch's avatar
Francesc Guasch committed
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
=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


115
sub create_domain {
116
117
    my $self = shift;

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

Francesc Guasch's avatar
Francesc Guasch committed
121
122
123
124
125
126
127
128
=head2 remove_domain

Removes a domain

  $ravada->remove_domain($name);

=cut

129
130
131
132
133
134
135
136
137
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
138
139
140
141
142
143
=head2 search_domain

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

=cut

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

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

154
155
=head2 list_domains

Francesc Guasch's avatar
Francesc Guasch committed
156
List all created domains
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172

  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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
=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
194
195
196
197
=head2 remove_volume

  $ravada->remove_volume($file);

Francesc Guasch's avatar
Francesc Guasch committed
198

Francesc Guasch's avatar
Francesc Guasch committed
199
200
=cut

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
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";
    }

}
221

Francesc Guasch's avatar
Francesc Guasch committed
222
223
224
225
226
227
228
229
=head2 process_requests

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

  $ravada->process_requests();

=cut

230
231
232
sub process_requests {
    my $self = shift;

233
234
    $Ravada::Request::CONNECTOR = $CONNECTOR;

235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
    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;

    if ($request->command() eq 'create' ) {
        $request->status('working');
        eval { $self->create_domain(%{$request->args}) };
        $request->status('done');
        $request->error($@);
    } elsif ($request->command eq 'remove') {
        $request->status('working');
        eval { $self->remove_domain($request->args('name')) };
        $request->status('done');
        $request->error($@);

    } else {
        die "Unknown command ".$request->command;
    }
}
Francesc Guasch's avatar
Francesc Guasch committed
262
263
264
265
266
267
268
269
270
271
272

=head1 AUTHOR

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

=head1 SEE ALSO

Sys::Virt

=cut

273
1;