line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# (c) Jan Gehring |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Rex::Inventory::Hal; |
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
15
|
use v5.12.5; |
|
1
|
|
|
|
|
4
|
|
8
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
6
|
use Rex::Inventory::Hal::Object; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
13
|
|
11
|
1
|
|
|
1
|
|
36
|
use Rex::Commands::Run; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
7
|
|
12
|
1
|
|
|
1
|
|
7
|
use Rex::Helper::Run; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
65
|
|
13
|
1
|
|
|
1
|
|
6
|
use Rex::Commands::Gather; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7
|
|
14
|
1
|
|
|
1
|
|
6
|
use Rex::Logger; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
17
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '1.14.3'; # VERSION |
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
72
|
use Data::Dumper; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
1291
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub new { |
21
|
0
|
|
|
0
|
0
|
|
my $that = shift; |
22
|
0
|
|
0
|
|
|
|
my $proto = ref($that) || $that; |
23
|
0
|
|
|
|
|
|
my $self = {@_}; |
24
|
|
|
|
|
|
|
|
25
|
0
|
|
|
|
|
|
bless( $self, $proto ); |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
|
$self->_read_lshal(); |
28
|
|
|
|
|
|
|
|
29
|
0
|
|
|
|
|
|
return $self; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# get devices of $category |
33
|
|
|
|
|
|
|
# like net or storage |
34
|
|
|
|
|
|
|
sub get_devices_of { |
35
|
|
|
|
|
|
|
|
36
|
0
|
|
|
0
|
0
|
|
my ( $self, $cat, $rex_class ) = @_; |
37
|
0
|
|
|
|
|
|
my @ret; |
38
|
|
|
|
|
|
|
|
39
|
0
|
|
|
|
|
|
for my $dev ( keys %{ $self->{'__hal'}->{$cat} } ) { |
|
0
|
|
|
|
|
|
|
40
|
0
|
|
|
|
|
|
push( @ret, $self->get_object_by_cat_and_udi( $cat, $dev, $rex_class ) ); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
return @ret; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# get network devices |
47
|
|
|
|
|
|
|
sub get_network_devices { |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
50
|
0
|
|
|
|
|
|
return $self->get_devices_of('net'); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# get storage devices |
55
|
|
|
|
|
|
|
sub get_storage_devices { |
56
|
|
|
|
|
|
|
|
57
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
58
|
0
|
|
|
|
|
|
my $os = get_operating_system(); |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
if ( $os =~ m/BSD/ ) { |
61
|
|
|
|
|
|
|
return |
62
|
0
|
|
0
|
|
|
|
grep { !$_->is_cdrom && !$_->is_volume && !$_->is_floppy } |
|
0
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
$self->get_devices_of( 'block', 'storage' ); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
else { |
66
|
|
|
|
|
|
|
# default linux |
67
|
|
|
|
|
|
|
return |
68
|
0
|
|
0
|
|
|
|
grep { !$_->is_cdrom && !$_->is_floppy } $self->get_devices_of('storage'); |
|
0
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# get storage volumes |
74
|
|
|
|
|
|
|
sub get_storage_volumes { |
75
|
|
|
|
|
|
|
|
76
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
77
|
|
|
|
|
|
|
|
78
|
0
|
|
|
|
|
|
my $os = get_operating_system(); |
79
|
|
|
|
|
|
|
|
80
|
0
|
0
|
|
|
|
|
if ( $os =~ m/BSD/ ) { |
81
|
|
|
|
|
|
|
return |
82
|
0
|
0
|
0
|
|
|
|
grep { !$_->is_cdrom && $_->is_volume && !$_->is_floppy } |
|
0
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
$self->get_devices_of( 'block', 'volume' ); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
else { |
86
|
|
|
|
|
|
|
# default linux |
87
|
0
|
|
|
|
|
|
return $self->get_devices_of('volume'); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# get a hal object from category and udi |
93
|
|
|
|
|
|
|
sub get_object_by_cat_and_udi { |
94
|
0
|
|
|
0
|
0
|
|
my ( $self, $cat, $udi, $rex_class ) = @_; |
95
|
|
|
|
|
|
|
|
96
|
0
|
|
0
|
|
|
|
$rex_class ||= $cat; |
97
|
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
|
my $class_name = "Rex::Inventory::Hal::Object::\u$rex_class"; |
99
|
0
|
|
|
|
|
|
eval "use $class_name"; |
100
|
0
|
0
|
|
|
|
|
if ($@) { |
101
|
0
|
|
|
|
|
|
Rex::Logger::debug( |
102
|
|
|
|
|
|
|
"This Hal Object isn't supported yet. Falling back to Base Object."); |
103
|
0
|
|
|
|
|
|
$class_name = "Rex::Inventory::Hal::Object"; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
0
|
|
|
|
|
|
return $class_name->new( %{ $self->{'__hal'}->{$cat}->{$udi} }, |
|
0
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
hal => $self ); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# get object by udi |
111
|
|
|
|
|
|
|
sub get_object_by_udi { |
112
|
0
|
|
|
0
|
0
|
|
my ( $self, $udi ) = @_; |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
for my $cat ( keys %{ $self->{'__hal'} } ) { |
|
0
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
for my $dev ( keys %{ $self->{'__hal'}->{$cat} } ) { |
|
0
|
|
|
|
|
|
|
116
|
0
|
0
|
|
|
|
|
if ( $dev eq $udi ) { |
117
|
0
|
|
|
|
|
|
return $self->get_object_by_cat_and_udi( $cat, $dev ); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# private method to read lshal output |
124
|
|
|
|
|
|
|
# you don't see that... |
125
|
|
|
|
|
|
|
sub _read_lshal { |
126
|
|
|
|
|
|
|
|
127
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
128
|
|
|
|
|
|
|
|
129
|
0
|
0
|
|
|
|
|
unless ( can_run "lshal" ) { |
130
|
0
|
|
|
|
|
|
Rex::Logger::info("No lshal available"); |
131
|
0
|
|
|
|
|
|
die; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
my @lines = i_run "lshal", fail_ok => 1; |
135
|
0
|
|
|
|
|
|
my %devices; |
136
|
|
|
|
|
|
|
my %tmp_devices; |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
my $in_dev = 0; |
139
|
0
|
|
|
|
|
|
my %data; |
140
|
|
|
|
|
|
|
my $dev_name; |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
for my $l (@lines) { |
143
|
0
|
|
|
|
|
|
chomp $l; |
144
|
|
|
|
|
|
|
|
145
|
0
|
0
|
|
|
|
|
if ( $l =~ m/^udi = '(.*?)'/ ) { |
146
|
0
|
|
|
|
|
|
$in_dev = 1; |
147
|
0
|
|
|
|
|
|
$dev_name = $1; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
0
|
0
|
|
|
|
|
if ( $l =~ m/^$/ ) { |
151
|
0
|
|
|
|
|
|
$in_dev = 0; |
152
|
0
|
0
|
|
|
|
|
unless ($dev_name) { |
153
|
0
|
|
|
|
|
|
%data = (); |
154
|
0
|
|
|
|
|
|
next; |
155
|
|
|
|
|
|
|
} |
156
|
0
|
|
|
|
|
|
$tmp_devices{$dev_name} = {%data}; |
157
|
0
|
|
|
|
|
|
%data = (); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
0
|
0
|
|
|
|
|
if ($in_dev) { |
161
|
0
|
|
|
|
|
|
my ( $key, $val ) = split( / = /, $l, 2 ); |
162
|
0
|
|
|
|
|
|
$key =~ s/^\s+//; |
163
|
0
|
|
|
|
|
|
$key =~ s/^'|'$//g; |
164
|
0
|
|
|
|
|
|
$val =~ s/\(.*?\)$//; |
165
|
0
|
|
|
|
|
|
$val =~ s/^\s+//; |
166
|
0
|
|
|
|
|
|
$val =~ s/\s+$//; |
167
|
0
|
|
|
|
|
|
$val =~ s/^'|'$//g; |
168
|
0
|
|
|
|
|
|
$data{$key} = $self->_parse_hal_string($val); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
|
|
|
for my $dev ( keys %tmp_devices ) { |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
my $s_key = $tmp_devices{$dev}->{"info.subsystem"} |
176
|
0
|
|
0
|
|
|
|
|| $tmp_devices{$dev}->{"linux.subsystem"}; |
177
|
0
|
|
0
|
|
|
|
$s_key ||= $tmp_devices{$dev}->{"info.category"}; |
178
|
|
|
|
|
|
|
|
179
|
0
|
0
|
|
|
|
|
if ( !$s_key ) { |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
#print Dumper($tmp_devices{$dev}); |
182
|
0
|
|
|
|
|
|
next; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
0
|
0
|
|
|
|
|
if ( $s_key =~ m/\./ ) { |
186
|
0
|
|
|
|
|
|
($s_key) = split( /\./, $s_key ); |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
0
|
0
|
|
|
|
|
if ( !exists $devices{$s_key} ) { |
190
|
0
|
|
|
|
|
|
$devices{$s_key} = {}; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
|
$devices{$s_key}->{$dev} = $tmp_devices{$dev}; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
$self->{'__hal'} = \%devices; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub _parse_hal_string { |
202
|
|
|
|
|
|
|
|
203
|
0
|
|
|
0
|
|
|
my ( $self, $line ) = @_; |
204
|
|
|
|
|
|
|
|
205
|
0
|
0
|
|
|
|
|
if ( $line =~ m/^\{.*\}$/ ) { |
206
|
0
|
|
|
|
|
|
$line =~ s/^\{/[/; |
207
|
0
|
|
|
|
|
|
$line =~ s/\}$/]/; |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
return eval $line; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
return $line; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
1; |