File Coverage

blib/lib/FusionInventory/Agent/Task/Inventory/Virtualization/VirtualBox.pm
Criterion Covered Total %
statement 15 58 25.8
branch 0 28 0.0
condition n/a
subroutine 5 8 62.5
pod 0 2 0.0
total 20 96 20.8


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::Task::Inventory::Virtualization::VirtualBox;
2              
3 1     1   40233473 use strict;
  1         7  
  1         93  
4 1     1   10 use warnings;
  1         1  
  1         102  
5              
6 1     1   6 use English qw(-no_match_vars);
  1         30  
  1         20  
7 1     1   1300 use User::pwent;
  1         9380  
  1         6  
8              
9 1     1   661 use FusionInventory::Agent::Tools;
  1         2  
  1         717  
10              
11             sub isEnabled {
12 0     0 0   my (%params) = @_;
13              
14 0 0         return unless canRun('VBoxManage');
15              
16 0           my ($major, $minor) = getFirstMatch(
17             command => 'VBoxManage --version',
18             pattern => qr/^(\d)\.(\d)/
19             );
20              
21 0           return compareVersion($major, $minor, 2, 1);
22             }
23              
24             sub doInventory {
25 0     0 0   my (%params) = @_;
26              
27 0           my $inventory = $params{inventory};
28 0           my $logger = $params{logger};
29              
30 0           my $command = "VBoxManage -nologo list --long vms";
31              
32 0           foreach my $machine (_parseVBoxManage(
33             logger => $logger, command => $command
34             )) {
35 0           $inventory->addEntry(
36             section => 'VIRTUALMACHINES', entry => $machine
37             );
38             }
39              
40 0 0         if (!$params{scan_homedirs}) {
41 0           $logger->warning(
42             "'scan-homedirs' configuration parameters disabled, " .
43             "ignoring virtualbox virtual machines in user directories"
44             );
45 0           return;
46             }
47              
48             # assume all system users with a suitable homedir is an actual human user
49 0 0         my $pattern = $OSNAME eq 'darwin' ?
50             qr{^/Users} : qr{^/home};
51              
52 0           my @users;
53 0           while (my $user = getpwent()) {
54 0 0         next unless $user->dir() =~ /$pattern/;
55 0           push @users, $user->name();
56             }
57              
58             # abort if too many users
59 0 0         return if @users > 10;
60              
61 0           foreach my $user (@users) {
62 0           my $command = "su '$user' -c 'VBoxManage -nologo list --long vms'";
63 0           foreach my $machine (_parseVBoxManage(
64             logger => $logger, command => $command
65             )) {
66 0           $machine->{OWNER} = $user;
67 0           $inventory->addEntry(
68             section => 'VIRTUALMACHINES', entry => $machine
69             );
70             }
71             }
72             }
73              
74             sub _parseVBoxManage {
75 0     0     my $handle = getFileHandle(@_);
76              
77 0 0         return unless $handle;
78              
79 0           my (@machines, $machine, $index);
80              
81 0           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 0           while (my $line = <$handle>) {
97 0           chomp $line;
98              
99 0 0         if ($line =~ m/^Name:\s+(.*)$/) {
    0          
    0          
    0          
    0          
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 0 0         if (defined $index) {
103 0           $index = undef;
104 0           next;
105             }
106 0 0         push @machines, $machine if $machine;
107 0           $machine = {
108             NAME => $1,
109             VCPU => 1,
110             SUBSYSTEM => 'Oracle VM VirtualBox',
111             VMTYPE => 'VirtualBox'
112             };
113             } elsif ($line =~ m/^UUID:\s+(.+)/) {
114 0           $machine->{UUID} = $1;
115             } elsif ($line =~ m/^Memory size:\s+(.+)/ ) {
116 0           $machine->{MEMORY} = $1;
117             } elsif ($line =~ m/^State:\s+(.+) \(/) {
118 0           $machine->{STATUS} = $status_list{$1};
119             } elsif ($line =~ m/^Index:\s+(\d+)$/) {
120 0           $index = $1;
121             }
122             }
123 0           close $handle;
124              
125             # push last remaining machine
126 0 0         push @machines, $machine if $machine;
127              
128 0           return @machines;
129             }
130              
131             1;