File Coverage

lib/Rex/Box/Base.pm
Criterion Covered Total %
statement 33 153 21.5
branch 0 28 0.0
condition 0 6 0.0
subroutine 12 35 34.2
pod 19 21 90.4
total 64 243 26.3


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             =head1 NAME
6              
7             Rex::Box::Base - Rex/Boxes Base Module
8              
9             =head1 DESCRIPTION
10              
11             This is a Rex/Boxes base module.
12              
13             =head1 METHODS
14              
15             These methods are shared across all other Rex::Box modules.
16              
17             =cut
18              
19             package Rex::Box::Base;
20              
21 1     1   14 use v5.12.5;
  1         4  
22 1     1   5 use warnings;
  1         3  
  1         64  
23              
24             our $VERSION = '1.14.2.2'; # TRIAL VERSION
25              
26 1     1   6 use Rex::Commands -no => [qw/auth/];
  1         4  
  1         9  
27 1     1   9 use Rex::Helper::Run;
  1         2  
  1         53  
28 1     1   5 use Rex::Commands::Fs;
  1         3  
  1         17  
29 1     1   13 use Rex::Commands::Virtualization;
  1         2  
  1         7  
30 1     1   19 use Rex::Commands::SimpleCheck;
  1         3  
  1         6  
31 1     1   8 use Rex::Helper::IP;
  1         2  
  1         18  
32              
33             BEGIN {
34 1     1   54 LWP::UserAgent->use;
35             }
36              
37 1     1   7 use Time::HiRes qw(tv_interval gettimeofday);
  1         2  
  1         7  
38 1     1   118 use File::Basename qw(basename);
  1         2  
  1         44  
39 1     1   6 use Data::Dumper;
  1         2  
  1         1660  
40              
41             sub new {
42 0     0 0   my $that = shift;
43 0   0       my $proto = ref($that) || $that;
44 0           my $self = {@_};
45              
46 0           bless( $self, $proto );
47              
48             # default auth for rex boxes
49             $self->{__auth} = {
50 0           user => Rex::Config->get_user(),
51             password => Rex::Config->get_password(),
52             private_key => Rex::Config->get_private_key(),
53             public_key => Rex::Config->get_public_key(),
54             };
55              
56             # for box this is needed, because we have changing ips
57 0           Rex::Config->set_openssh_opt(
58             StrictHostKeyChecking => "no",
59             UserKnownHostsFile => "/dev/null",
60             LogLevel => "QUIET"
61             );
62              
63 0           return $self;
64             }
65              
66             =head2 info
67              
68             Returns a hashRef of vm information.
69              
70             =cut
71              
72             sub info {
73 0     0 1   my ($self) = @_;
74 0           return $self->{info};
75             }
76              
77             =head2 name($vmname)
78              
79             Sets the name of the virtual machine.
80              
81             =cut
82              
83             sub name {
84 0     0 1   my ( $self, $name ) = @_;
85 0           $self->{name} = $name;
86             }
87              
88             =head2 setup(@tasks)
89              
90             Sets the tasks that should be executed as soon as the VM is available through SSH.
91              
92             =cut
93              
94             =head2 storage('path/to/vm/disk')
95              
96             Sets the disk path of the virtual machine. Works only on KVM
97              
98             =cut
99              
100             sub storage {
101 0     0 1   my ( $self, $folder ) = @_;
102              
103 0           $self->{storage_path} = $folder;
104             }
105              
106             sub setup {
107 0     0 1   my ( $self, @tasks ) = @_;
108 0           $self->{__tasks} = \@tasks;
109             }
110              
111             =head2 import_vm()
112              
113             This method must be overwritten by the implementing class.
114              
115             =cut
116              
117             sub import_vm {
118 0     0 1   my ($self) = @_;
119 0           die("This method must be overwritten.");
120             }
121              
122             =head2 stop()
123              
124             Stops the VM.
125              
126             =cut
127              
128             sub stop {
129 0     0 1   my ($self) = @_;
130 0           $self->info;
131 0           vm shutdown => $self->{name};
132             }
133              
134             =head2 destroy()
135              
136             Destroy the VM.
137              
138             =cut
139              
140             sub destroy {
141 0     0 1   my ($self) = @_;
142 0           $self->info;
143 0           vm destroy => $self->{name};
144             }
145              
146             =head2 start()
147              
148             Starts the VM.
149              
150             =cut
151              
152             sub start {
153 0     0 1   my ($self) = @_;
154 0           $self->info;
155 0           vm start => $self->{name};
156              
157             }
158              
159             =head2 ip()
160              
161             Return the ip:port to which rex will connect to.
162              
163             =cut
164              
165 0     0 1   sub ip { die("Must be implemented by box class.") }
166              
167             =head2 status()
168              
169             Returns the status of a VM.
170              
171             Valid return values are "running" and "stopped".
172              
173             =cut
174              
175             sub status {
176 0     0 1   my ($self) = @_;
177 0           return vm status => $self->{name};
178             }
179              
180             =head2 provision_vm([@tasks])
181              
182             Executes the given tasks on the VM.
183              
184             =cut
185              
186             sub provision_vm {
187 0     0 1   my ( $self, @tasks ) = @_;
188              
189 0 0         if ( !@tasks ) {
190 0 0         @tasks = @{ $self->{__tasks} } if ( exists $self->{__tasks} );
  0            
191             }
192              
193 0           $self->wait_for_ssh();
194              
195 0           for my $task (@tasks) {
196 0           my $task_o = Rex::TaskList->create()->get_task($task);
197 0 0         if ( !$task_o ) {
198 0           die "Task $task not found.";
199             }
200              
201 0           $task_o->set_auth( %{ $self->{__auth} } );
  0            
202 0           Rex::Commands::set( "box_object", $self );
203 0           $task_o->run( $self->ip );
204 0           Rex::Commands::set( "box_object", undef );
205             }
206             }
207              
208             =head2 cpus($count)
209              
210             Set the amount of CPUs for the VM.
211              
212             =cut
213              
214             sub cpus {
215 0     0 1   my ( $self, $cpus ) = @_;
216 0           $self->{cpus} = $cpus;
217             }
218              
219             =head2 memory($memory_size)
220              
221             Sets the memory of a VM in megabyte.
222              
223             =cut
224              
225             sub memory {
226 0     0 1   my ( $self, $mem ) = @_;
227 0           $self->{memory} = $mem;
228             }
229              
230             =head2 network(%option)
231              
232             Configure the network for a VM.
233              
234             Currently it supports 2 modes: I and I. Currently it supports only one network card.
235              
236             $box->network(
237             1 => {
238             type => "nat",
239             },
240             }
241              
242             $box->network(
243             1 => {
244             type => "bridged",
245             bridge => "eth0",
246             },
247             );
248              
249             =cut
250              
251             sub network {
252 0     0 1   my ( $self, %option ) = @_;
253 0           $self->{__network} = \%option;
254             }
255              
256             =head2 forward_port(%option)
257              
258             Set ports to be forwarded to the VM. This is not supported by all Box providers.
259              
260             $box->forward_port(
261             name => [$from_host_port, $to_vm_port],
262             name2 => [$from_host_port_2, $to_vm_port_2],
263             ...
264             );
265              
266             =cut
267              
268             sub forward_port {
269 0     0 1   my ( $self, %option ) = @_;
270 0           $self->{__forward_port} = \%option;
271             }
272              
273             =head2 list_boxes
274              
275             List all available boxes.
276              
277             =cut
278              
279             sub list_boxes {
280 0     0 1   my ($self) = @_;
281              
282 0           my $vms = vm list => "all";
283              
284 0           return @{$vms};
  0            
285             }
286              
287             =head2 url($url)
288              
289             The URL where to download the Base VM Image. You can use self-made images or prebuild images from L.
290              
291             =cut
292              
293             sub url {
294 0     0 1   my ( $self, $url, $force ) = @_;
295 0           $self->{url} = $url;
296 0           $self->{force} = $force;
297             }
298              
299             =head2 auth(%option)
300              
301             Configure the authentication to the VM.
302              
303             $box->auth(
304             user => $user,
305             password => $password,
306             private_key => $private_key,
307             public_key => $public_key,
308             );
309              
310             =cut
311              
312             sub auth {
313 0     0 1   my ( $self, %auth ) = @_;
314 0 0         if (%auth) {
315 0           $self->{__auth} = \%auth;
316             }
317             else {
318 0           return $self->{__auth};
319             }
320             }
321              
322             =head2 options(%option)
323              
324             Addition options for boxes
325              
326             $box->options(
327             opt1 => $val1,
328             opt2 => $val2,
329             );
330              
331             =cut
332              
333             sub options {
334 0     0 1   my ( $self, %opt ) = @_;
335 0 0         if (%opt) {
336 0           $self->{__options} = \%opt;
337             }
338             else {
339 0           return $self->{__options};
340             }
341             }
342              
343             sub wait_for_ssh {
344 0     0 0   my ( $self, $ip, $port ) = @_;
345              
346 0 0         if ( !$ip ) {
347 0           ( $ip, $port ) = Rex::Helper::IP::get_server_and_port( $self->ip, 22 );
348             }
349              
350 0           print "Waiting for SSH to come up on $ip:$port.";
351 0           while ( !is_port_open( $ip, $port ) ) {
352 0           print ".";
353 0           sleep 1;
354             }
355              
356 0           print "\n";
357             }
358              
359             sub _download {
360 0     0     my ($self) = @_;
361              
362 0           my $filename = basename( $self->{url} );
363 0   0       my $force = $self->{force} || FALSE;
364 0           my $fs = Rex::Interface::Fs->create;
365              
366 0 0         if ( $fs->is_file("./tmp/$filename") ) {
367 0           Rex::Logger::info(
368             "File already downloaded. Please remove the file ./tmp/$filename if you want to download a fresh copy."
369             );
370             }
371             else {
372 0           $force = TRUE;
373             }
374              
375 0 0         if ($force) {
376 0           Rex::Logger::info("Downloading $self->{url} to ./tmp/$filename");
377 0           mkdir "tmp";
378 0 0         if ( Rex::is_local() ) {
379 0           my $ua = LWP::UserAgent->new();
380 0           $ua->env_proxy;
381 0           my $final_data = "";
382 0           my $current_size = 0;
383 0           my $current_modulo = 0;
384 0           my $start_time = [ gettimeofday() ];
385 0 0         open( my $fh, ">", "./tmp/$filename" )
386             or die("Failed to open ./tmp/$filename for writing: $!");
387 0           binmode $fh;
388             my $resp = $ua->get(
389             $self->{url},
390             ':content_cb' => sub {
391 0     0     my ( $data, $response, $protocol ) = @_;
392              
393 0           $current_size += length($data);
394              
395 0           my $content_length = $response->header("content-length");
396              
397 0           print $fh $data;
398              
399 0           my $current_time = [ gettimeofday() ];
400 0           my $time_diff = tv_interval( $start_time, $current_time );
401              
402 0           my $bytes_per_seconds = $current_size / $time_diff;
403              
404 0           my $mbytes_per_seconds = $bytes_per_seconds / 1024 / 1024;
405              
406 0           my $mbytes_current = $current_size / 1024 / 1024;
407 0           my $mbytes_total = $content_length / 1024 / 1024;
408              
409 0           my $left_bytes = $content_length - $current_size;
410              
411 0           my $time_one_byte = $time_diff / $current_size;
412 0           my $time_all_bytes =
413             $time_one_byte * ( $content_length - $current_size );
414              
415 0 0         if ( ( ( $current_size / ( 1024 * 1024 ) ) % ( 1024 * 1024 ) ) >
416             $current_modulo )
417             {
418 0           print ".";
419 0           $current_modulo++;
420              
421 0 0         if ( $current_modulo % 10 == 0 ) {
422 0           printf(
423             ". %.2f MBytes/s (%.2f MByte / %.2f MByte) %.2f secs left\n",
424             $mbytes_per_seconds, $mbytes_current,
425             $mbytes_total, $time_all_bytes
426             );
427             }
428              
429             }
430              
431             }
432 0           );
433 0           close($fh);
434              
435 0 0         if ( $resp->is_success ) {
436 0           print " done.\n";
437             }
438             else {
439 0           Rex::Logger::info( "Error downloading box image.", "warn" );
440 0           unlink "./tmp/$filename";
441             }
442              
443             }
444             else {
445 0           i_exec "wget", "-c", "-qO", "./tmp/$filename", $self->{url};
446              
447 0 0         if ( $? != 0 ) {
448 0           die(
449             "Downloading of $self->{url} failed. Please verify if wget is installed and if you have the right permissions to download this box."
450             );
451             }
452             }
453             }
454             }
455              
456             1;