File Coverage

blib/lib/FusionInventory/Agent/Task/Inventory/Virtualization/VirtualBox.pm
Criterion Covered Total %
statement 34 58 58.6
branch 16 28 57.1
condition n/a
subroutine 6 8 75.0
pod 0 2 0.0
total 56 96 58.3


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::Task::Inventory::Virtualization::VirtualBox;
2              
3 3     3   52928108 use strict;
  3         6  
  3         130  
4 3     3   19 use warnings;
  3         5  
  3         163  
5              
6 3     3   14 use English qw(-no_match_vars);
  3         94  
  3         39  
7 3     3   4672 use User::pwent;
  3         15800  
  3         15  
8              
9 3     3   895 use FusionInventory::Agent::Tools;
  3         9  
  3         2748  
10              
11             sub isEnabled {
12 0     0 0 0 my (%params) = @_;
13              
14 0 0       0 return unless canRun('VBoxManage');
15              
16 0         0 my ($major, $minor) = getFirstMatch(
17             command => 'VBoxManage --version',
18             pattern => qr/^(\d)\.(\d)/
19             );
20              
21 0         0 return compareVersion($major, $minor, 2, 1);
22             }
23              
24             sub doInventory {
25 0     0 0 0 my (%params) = @_;
26              
27 0         0 my $inventory = $params{inventory};
28 0         0 my $logger = $params{logger};
29              
30 0         0 my $command = "VBoxManage -nologo list --long vms";
31              
32 0         0 foreach my $machine (_parseVBoxManage(
33             logger => $logger, command => $command
34             )) {
35 0         0 $inventory->addEntry(
36             section => 'VIRTUALMACHINES', entry => $machine
37             );
38             }
39              
40 0 0       0 if (!$params{scan_homedirs}) {
41 0         0 $logger->warning(
42             "'scan-homedirs' configuration parameters disabled, " .
43             "ignoring virtualbox virtual machines in user directories"
44             );
45 0         0 return;
46             }
47              
48             # assume all system users with a suitable homedir is an actual human user
49 0 0       0 my $pattern = $OSNAME eq 'darwin' ?
50             qr{^/Users} : qr{^/home};
51              
52 0         0 my @users;
53 0         0 while (my $user = getpwent()) {
54 0 0       0 next unless $user->dir() =~ /$pattern/;
55 0         0 push @users, $user->name();
56             }
57              
58             # abort if too many users
59 0 0       0 return if @users > 10;
60              
61 0         0 foreach my $user (@users) {
62 0         0 my $command = "su '$user' -c 'VBoxManage -nologo list --long vms'";
63 0         0 foreach my $machine (_parseVBoxManage(
64             logger => $logger, command => $command
65             )) {
66 0         0 $machine->{OWNER} = $user;
67 0         0 $inventory->addEntry(
68             section => 'VIRTUALMACHINES', entry => $machine
69             );
70             }
71             }
72             }
73              
74             sub _parseVBoxManage {
75 6     6   1698 my $handle = getFileHandle(@_);
76              
77 6 50       18 return unless $handle;
78              
79 6         10 my (@machines, $machine, $index);
80              
81 6         71 my %status_list = (
82             'powered off' => 'off',
83             'saved' => 'off',
84             'teleported' => 'off',
85             'aborted' => 'crashed',
86             'stuck' => 'blocked',
87             'teleporting' => 'paused',
88             'live snapshotting' => 'running',
89             'starting' => 'running',
90             'stopping' => 'dying',
91             'saving' => 'dying',
92             'restoring' => 'running',
93             'running' => 'running',
94             'paused' => 'paused'
95             );
96 6         136 while (my $line = <$handle>) {
97 4182         4983 chomp $line;
98              
99 4182 100       26268 if ($line =~ m/^Name:\s+(.*)$/) {
    100          
    100          
    100          
    100          
100             # this is a little tricky, because USB devices also have a 'name'
101             # field, so let's use the 'index' field to disambiguate
102 68 100       145 if (defined $index) {
103 12         17 $index = undef;
104 12         41 next;
105             }
106 56 100       143 push @machines, $machine if $machine;
107 56         359 $machine = {
108             NAME => $1,
109             VCPU => 1,
110             SUBSYSTEM => 'Oracle VM VirtualBox',
111             VMTYPE => 'VirtualBox'
112             };
113             } elsif ($line =~ m/^UUID:\s+(.+)/) {
114 56         362 $machine->{UUID} = $1;
115             } elsif ($line =~ m/^Memory size:\s+(.+)/ ) {
116 56         249 $machine->{MEMORY} = $1;
117             } elsif ($line =~ m/^State:\s+(.+) \(/) {
118 56         261 $machine->{STATUS} = $status_list{$1};
119             } elsif ($line =~ m/^Index:\s+(\d+)$/) {
120 12         53 $index = $1;
121             }
122             }
123 6         226 close $handle;
124              
125             # push last remaining machine
126 6 50       23 push @machines, $machine if $machine;
127              
128 6         64 return @machines;
129             }
130              
131             1;