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