source: repository/lib/Metabrik/System/Virtualbox.pm

Last change on this file was 897:e0dd24ebc64e, checked in by GomoR <gomor@…>, 8 weeks ago
  • bugfix: system::virtualbox: state is named running when a VM is started.
  • update: network::portscan: tcp_syn_start_receiver Command to take optional filter Arg
  • new: remote::sandbox: create_client, save_elasticsearch_state, restore_elasticsearch_state, restart_sysmon_collector, upload_and_execute, diff_ps_state and diff_ps_network_connections Commands
File size: 10.1 KB
Line 
1#
2# $Id$
3#
4# system::virtualbox Brik
5#
6package Metabrik::System::Virtualbox;
7use strict;
8use warnings;
9
10use base qw(Metabrik::Shell::Command Metabrik::System::Package);
11
12sub brik_properties {
13   return {
14      revision => '$Revision$',
15      tags => [ qw(unstable) ],
16      author => 'GomoR <GomoR[at]metabrik.org>',
17      license => 'http://opensource.org/licenses/BSD-3-Clause',
18      attributes => {
19         datadir => [ qw(datadir) ],
20         capture_mode => [ qw(0|1) ],
21         type => [ qw(gui|sdl|headless) ],
22      },
23      attributes_default => {
24         capture_mode => 1,
25         type => 'gui',
26      },
27      commands => {
28         install => [ ], # Inherited
29         command => [ qw(command) ],
30         list => [ ],
31         start => [ qw(name type|OPTIONAL) ],
32         restore => [ qw(name type|OPTIONAL) ], # Alias for start
33         stop => [ qw(name) ],
34         save => [ qw(name) ],
35         snapshot_list => [ qw(name) ],
36         snapshot_live => [ qw(name snapshot_name description|OPTIONAL) ],
37         snapshot_delete => [ qw(name snapshot_name) ],
38         snapshot_restore => [ qw(name snapshot_name) ],
39         screenshot => [ qw(name output.png|OPTIONAL) ],
40         dumpguestcore => [ qw(name output.elf|OPTIONAL) ],
41         dumpvmcore => [ qw(name output.elf|OPTIONAL) ],
42         extract_memdump_from_dumpguestcore => [ qw(input output.vol|OPTIONAL) ],
43         restart => [ qw(name type|OPTIONAL) ],
44         info => [ qw(name) ],
45         is_started => [ qw(name) ],
46         is_stopped => [ qw(name) ],
47         get_current_snapshot_id => [ qw(name) ],
48      },
49      require_modules => {
50         'Metabrik::File::Raw' => [ ],
51         'Metabrik::File::Read' => [ ],
52         'Metabrik::File::Readelf' => [ ],
53         'Metabrik::System::File' => [ ],
54      },
55      require_binaries => {
56         vboxmanage => [ ],
57      },
58      need_packages => {
59         ubuntu => [ qw(virtualbox) ],
60         debian => [ qw(virtualbox) ],
61      },
62   };
63}
64
65sub command {
66   my $self = shift;
67   my ($command) = @_;
68
69   $self->brik_help_run_undef_arg('command', $command) or return;
70
71   return $self->execute("vboxmanage $command");
72}
73
74sub list {
75   my $self = shift;
76
77   my %vms = ();
78   my $lines = $self->command('list vms') or return;
79   for my $line (@$lines) {
80      my ($name, $uuid) = $line =~ m/^\s*"([^"]+)"\s+{([^}]+)}\s*$/;
81      $vms{$uuid} = { uuid => $uuid, name => $name };
82   }
83
84   return \%vms;
85}
86
87sub start {
88   my $self = shift;
89   my ($name, $type) = @_;
90
91   $type ||= $self->type;
92   $self->brik_help_run_undef_arg('start', $name) or return;
93   $self->brik_help_run_undef_arg('start', $type) or return;
94
95   if ($self->is_started($name)) {
96      return $self->log->info("start: VM with name [$name] already started");
97   }
98
99   return $self->command("startvm \"$name\" --type $type");
100}
101
102sub restore {
103   my $self = shift;
104
105   return $self->start(@_);
106}
107
108sub stop {
109   my $self = shift;
110   my ($name) = @_;
111
112   $self->brik_help_run_undef_arg('stop', $name) or return;
113
114   if ($self->is_stopped($name)) {
115      return $self->log->info("start: VM with name [$name] already stopped");
116   }
117
118   return $self->command("controlvm \"$name\" poweroff");
119}
120
121sub save {
122   my $self = shift;
123   my ($name) = @_;
124
125   $self->brik_help_run_undef_arg('save', $name) or return;
126
127   return $self->command("controlvm \"$name\" savestate");
128}
129
130sub snapshot_list {
131   my $self = shift;
132   my ($name) = @_;
133
134   $self->brik_help_run_undef_arg('snapshot_list', $name) or return;
135
136   my $lines = $self->command("snapshot \"$name\" list");
137
138   my @list = ();
139   for my $line (@$lines) {
140      if ($line =~ m{^\s*Name:}) {
141         my ($descr, $id) = $line =~ m{^\s*Name:\s+([^\(]+)\(UUID:\s+([^\)]+)\)};
142         if (defined($descr) && defined($id)) {
143            my $current = 0;
144            if ($line =~ m{\*$}) {
145               $current = 1;
146            }
147            $descr =~ s{\s*$}{};
148            push @list, {
149               name => $descr,
150               uuid => $id,
151               current => $current,
152            };
153         }
154      }
155   }
156
157   return \@list;
158}
159
160sub snapshot_live {
161   my $self = shift;
162   my ($name, $snapshot_name, $description) = @_;
163
164   $description ||= 'snapshot';
165   $self->brik_help_run_undef_arg('snapshot_live', $name) or return;
166   $self->brik_help_run_undef_arg('snapshot_live', $snapshot_name) or return;
167
168   return $self->command("snapshot \"$name\" take \"$snapshot_name\" --description \"$description\" --live");
169}
170
171sub snapshot_delete {
172   my $self = shift;
173   my ($name, $snapshot_name) = @_;
174
175   $self->brik_help_run_undef_arg('snapshot_delete', $name) or return;
176   $self->brik_help_run_undef_arg('snapshot_delete', $snapshot_name) or return;
177
178   return $self->command("snapshot \"$name\" delete \"$snapshot_name\"");
179}
180
181sub snapshot_restore {
182   my $self = shift;
183   my ($name, $snapshot_name) = @_;
184
185   $self->brik_help_run_undef_arg('snapshot_restore', $name) or return;
186   $self->brik_help_run_undef_arg('snapshot_restore', $snapshot_name) or return;
187
188   return $self->command("snapshot \"$name\" restore \"$snapshot_name\"");
189}
190
191sub screenshot {
192   my $self = shift;
193   my ($name, $output) = @_;
194
195   $output ||= $self->datadir."/screenshot.png";
196   $self->brik_help_run_undef_arg('screenshot', $name) or return;
197
198   $self->command("controlvm \"$name\" screenshotpng \"$output\"") or return;
199
200   return $output;
201}
202
203#
204# Dump guestcore
205#
206sub dumpguestcore {
207   my $self = shift;
208   my ($name, $output) = @_;
209
210   $output ||= $self->datadir.'/output.elf';
211   $self->brik_help_run_undef_arg('dumpguestcore', $name) or return;
212
213   if (-f $output) {
214      my $sf = Metabrik::System::File->new_from_brik_init($self) or return;
215      $sf->remove($output) or return;
216   }
217
218   $self->command("debugvm \"$name\" dumpguestcore --filename \"$output\"") or return;
219
220   return $output;
221}
222
223#
224# Dump vmcore, same as dump guestcore but for newer versions of VirtualBox which renamed
225# the function
226#
227sub dumpvmcore {
228   my $self = shift;
229   my ($name, $output) = @_;
230
231   $output ||= $self->datadir.'/output.elf';
232   $self->brik_help_run_undef_arg('dumpvmcore', $name) or return;
233
234   if (-f $output) {
235      my $sf = Metabrik::System::File->new_from_brik_init($self) or return;
236      $sf->remove($output) or return;
237   }
238
239   $self->command("debugvm \"$name\" dumpvmcore --filename \"$output\"") or return;
240
241   return $output;
242}
243
244#
245# By taking information from:
246# http://wiki.yobi.be/wiki/RAM_analysis#RAM_dump_with_VirtualBox:_via_ELF64_coredump
247#
248sub extract_memdump_from_dumpguestcore {
249   my $self = shift;
250   my ($input, $output) = @_;
251
252   $output ||= $self->datadir.'/output.vol';
253   $self->brik_help_run_undef_arg('extract_memdump_from_dumpguestcore', $input) or return;
254
255   my $fraw = Metabrik::File::Raw->new_from_brik_init($self) or return;
256   my $fread = Metabrik::File::Read->new_from_brik_init($self) or return;
257   my $felf = Metabrik::File::Readelf->new_from_brik_init($self) or return;
258
259   my $headers = $felf->program_headers($input) or return;
260
261   my $offset = 0;
262   my $size = 0;
263   for my $section (@{$headers->{sections}}) {
264      if ($section->{type} eq 'LOAD') {
265         $offset = hex($section->{offset});
266         $size = hex($section->{filesiz});
267         last;
268      }
269   }
270   if (! $offset || ! $size) {
271      return $self->log->error("extract_memdump_from_dumpguestcore: unable to find memdump");
272   }
273
274   $self->log->verbose("extract_memdump_from_dumpguestcore: offset[$offset] size[$size]");
275
276   $fread->encoding('ascii');  # Raw mode
277   my $fdin = $fread->open($input) or return;
278   $fread->seek($offset) or return;
279
280   if (-f $output) {
281      my $sf = Metabrik::System::File->new_from_brik_init($self) or return;
282      $sf->remove($output) or return;
283   }
284
285   my $written = 0;
286   my $fdout = $fraw->open($output) or return;
287   while (<$fdin>) {
288      my $this = length($_);
289      if (($written + $this) <= $size) {
290         print $fdout $_;
291         $written += $this;
292      }
293      else {
294         my $rest = $size - $written;
295         if ($rest < 0) {
296            $self->log->warning("extract_memdump_from_dumpguestcore: error while reading input");
297            last;
298         }
299         my $tail = substr($_, 0, $rest);
300         print $fdout $tail;
301         last;
302      }
303   }
304   $fraw->close;
305   $fread->close;
306
307   return $output;
308}
309
310sub restart {
311   my $self = shift;
312   my ($name, $type) = @_;
313
314   $self->brik_help_run_undef_arg('restart', $name) or return;
315
316   $self->stop($name) or return;
317   sleep(2);
318   return $self->start($name, $type);
319}
320
321sub info {
322   my $self = shift;
323   my ($name) = @_;
324
325   $self->brik_help_run_undef_arg('info', $name) or return;
326
327   my $lines = $self->command("showvminfo \"$name\"") or return;
328
329   my $info = {};
330   if (@$lines > 0) {
331      for my $line (@$lines) {
332         my @t = split(/:/, $line, 2);
333         my $k = $t[0];
334         my $v = $t[1];
335         next unless defined($v);
336         $k =~ s{^\s*}{};
337         $k =~ s{\s*$}{};
338         $v =~ s{^\s*}{};
339         $v =~ s{\s*$}{};
340         if (length($k) && length($v)) {
341            $k =~ s{ }{_}g;
342            $k =~ s{(\(|\))}{}g;
343            $info->{lc($k)} = $v;
344         }
345      }
346   }
347
348   return $info;
349
350}
351
352sub is_started {
353   my $self = shift;
354   my ($name) = @_;
355
356   $self->brik_help_run_undef_arg('is_started', $name) or return;
357
358   my $info = $self->info($name) or return;
359   my $state = $info->{state} || 'undef';
360   if ($state =~ m{running}) {
361      return 1;
362   }
363
364   return 0;
365}
366
367sub is_stopped {
368   my $self = shift;
369   my ($name) = @_;
370
371   $self->brik_help_run_undef_arg('is_stopped', $name) or return;
372
373   return ! $self->is_started($name);
374}
375
376sub get_current_snapshot_id {
377   my $self = shift;
378   my ($name) = @_;
379
380   $self->brik_help_run_undef_arg('get_current_snapshot_id', $name) or return;
381
382   my $list = $self->snapshot_list($name) or return;
383
384   for my $this (@$list) {
385      if ($this->{current}) {
386         return $this->{uuid};
387      }
388   }
389
390   return 0;
391}
392
3931;
394
395__END__
396
397=head1 NAME
398
399Metabrik::System::Virtualbox - system::virtualbox Brik
400
401=head1 COPYRIGHT AND LICENSE
402
403Copyright (c) 2014-2017, Patrice E<lt>GomoRE<gt> Auffret
404
405You may distribute this module under the terms of The BSD 3-Clause License.
406See LICENSE file in the source distribution archive.
407
408=head1 AUTHOR
409
410Patrice E<lt>GomoRE<gt> Auffret
411
412=cut
Note: See TracBrowser for help on using the repository browser.